home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue41 / Construc / DRBOBNEW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-12-07  |  8.5 KB  |  334 lines
  1. unit DrBobNEW;
  2. {.$R+}
  3. {$DEFINE DEBUG}
  4. interface
  5. uses
  6.   Classes, {$IFDEF DEBUG}StdCtrls,{$ENDIF} ScktComp;
  7.  
  8. const
  9.   MaxGroups = 256;
  10.  
  11. type
  12.   TBNNTP = class(TComponent)
  13.   public
  14.     constructor Create(AOwner: TComponent); override;
  15.     destructor Destroy; override;
  16.   public
  17.   {$IFDEF DEBUG}
  18.     StatusMemo: TMemo; { pointer to Form's Memo }
  19.   {$ENDIF}
  20.     procedure Connect;
  21.     procedure JoinNewsGroup(const NewsGroup: String);
  22.     procedure ReadArticle(ArticleNr: Integer);
  23.     procedure Disconnect;
  24.  
  25.   protected
  26.     _Socket: TClientSocket;
  27.     procedure SocketRead(Sender: TObject; Socket: TCustomWinSocket);
  28.     procedure SocketWrite(Sender: TObject; Socket: TCustomWinSocket);
  29.     procedure Wait;
  30.  
  31.   private
  32.     fNewsServer: String;
  33.   published
  34.     property NewsServer: String read fNewsServer write fNewsServer;
  35.  
  36.   private // newgroups
  37.     fNumGroups: Integer;
  38.     fNewsGroups: Array[0..MaxGroups-1] of String;
  39.     function GetNewsGroup(Index: Integer): String;
  40.   public
  41.     property NewsGroups: Integer read fNumGroups;
  42.     property NewsGroup[Index: Integer]: String read GetNewsGroup;
  43.  
  44.   private // articles
  45.     fFirstArticle,fLastArticle: Integer;
  46.     fArticles: Array of String;
  47.     function GetArticle(Index: Integer): String;
  48.   public
  49.     property FirstArticle: Integer read fFirstArticle;
  50.     property LastArticle: Integer read fLastArticle;
  51.     property Article[Index: Integer]: String read GetArticle;
  52.  
  53.   private // internal
  54.     WinSocket: TCustomWinSocket;
  55.     Command: Integer;
  56.     ArtNr: Integer;
  57.     Status: String; { also NewsgroupName }
  58.   {$IFDEF DEBUG}
  59.     Indent: Integer;
  60.   {$ENDIF}
  61.   end;
  62.  
  63.   procedure Register;
  64.  
  65. implementation
  66. uses
  67.   SysUtils, Forms;
  68.  
  69. const
  70.   CmdStart =   0;
  71.   CmdList  =   1; { list newsgroups }
  72.   CmdJoin  =   2; { join newsgroup }
  73.   CmdMess  =   3; { read article # }
  74.   CmdDone  =  42; { signals ready }
  75.   CmdQuit  = 666;
  76.  
  77. const
  78.   NNTP = 119;
  79.  
  80. const
  81.   CRLF = #13#10;
  82.  
  83. {$IFDEF DEBUG}
  84.   function Space(X: Integer): String;
  85.   begin
  86.     Result := '';
  87.     while X > 0 do
  88.     begin
  89.       Result := Result + ' ';
  90.       Dec(X)
  91.     end
  92.   end {Space};
  93. {$ENDIF}
  94.  
  95. constructor TBNNTP.Create(AOwner: TComponent);
  96. begin
  97.   inherited Create(AOwner);
  98.   _Socket := TClientSocket.Create(Self);
  99.   _Socket.Port := NNTP;
  100.   _Socket.OnRead := SocketRead;
  101.   _Socket.OnWrite := SocketWrite;
  102. {$IFDEF DEBUG}
  103.   Indent := 0;
  104.   StatusMemo := nil;
  105. {$ENDIF}
  106.   WinSocket := nil
  107. end {Create};
  108.  
  109. destructor TBNNTP.Destroy;
  110. begin
  111.   _Socket.OnRead := nil;
  112.   _Socket.OnWrite := nil;
  113. //if Assigned(WinSocket) and (Command <> CmdQuit) then
  114. //  WinSocket.SendText('QUIT'+ CRLF);
  115.   WinSocket := nil;
  116.   _Socket.Free;
  117.   _Socket := nil;
  118. {$IFDEF DEBUG}
  119.   StatusMemo := nil;
  120. {$ENDIF}
  121.   inherited Destroy
  122. end {Destroy};
  123.  
  124.  
  125. function TBNNTP.GetNewsGroup(Index: Integer): String;
  126. begin
  127.   if Index < MaxGroups then Result := fNewsGroups[Index]
  128.                        else Result := ''
  129. end {GetNewsGroup};
  130.  
  131. function TBNNTP.GetArticle(Index: Integer): String;
  132. begin
  133.   if (Index >= fFirstArticle) and
  134.     ((Index-fFirstArticle) < Length(fArticles)) then
  135.     Result := fArticles[Index-fFirstArticle]
  136.   else Result := ''
  137. end {GetArticle};
  138.  
  139.  
  140. procedure TBNNTP.SocketRead(Sender: TObject; Socket: TCustomWinSocket);
  141. var
  142.   i,j: Integer;
  143.   EOD: Boolean; { end-of-data }
  144. begin
  145. {$IFDEF DEBUG}
  146.   if Assigned(StatusMemo) then
  147.     StatusMemo.Lines.Add(Space(Indent)+'SocketRead');
  148. {$ENDIF}
  149.   WinSocket := Socket; { talk back? }
  150.   Status := Socket.ReceiveText;
  151.   while (Length(Status) > 0) and (Status[Length(Status)] in [#10,#13]) do
  152.     Delete(Status,Length(Status),1);
  153.   EOD := Pos(CRLF+'.',Copy(Status,Length(Status)-4,5)) > 0;
  154.   // Pos(CRLF+'.',Status) > (Length(Status)-4);
  155. {$IFDEF DEBUG}
  156.   if Assigned(StatusMemo) then
  157.   begin
  158.     if Command <> CmdMess then
  159.       StatusMemo.Lines.Add(Space(Indent)+Status)
  160.     else StatusMemo.Lines.Add(Space(Indent)+Copy(Status,1,Pos(#13,Status)-1));
  161.     StatusMemo.Update; { force repaint }
  162.   end
  163.   else
  164.     if IsConsole then writeln(Status);
  165. {$ENDIF}
  166.   case Command of
  167.     CmdStart:
  168.       begin
  169.         Command := CmdList; { get newsgroup list }
  170.         ArtNr := 0
  171.       end;
  172.      CmdList:
  173.        begin
  174.          fNumGroups := -1;
  175.          while Length(Status) > 1 do
  176.          begin
  177.            Inc(fNumGroups);
  178.            i := Pos(#13,Status);
  179.            j := Pos(#10,Status);
  180.            if (i = 0) and (j = 0) then i := Length(Status)
  181.            else
  182.              if j > i then i := j;
  183.            j := 1;
  184.            while (j < i) and (Status[j] > #32) do Inc(j);
  185.            if fNumGroups > 0 then
  186.            begin
  187.              fNewsGroups[fNumGroups-1] := Copy(Status,1,j-1);
  188.              if fNewsGroups[fNumGroups-1] = '' then
  189.                Dec(fNumGroups)
  190.            end;
  191.            Delete(Status,1,i);
  192.            while (Length(Status) > 0) and (Status[1] in [#10,#13]) do Delete(Status,1,1)
  193.          end;
  194.          if (Status = '.') or EOD then Command := CmdDone
  195.                                   else ArtNr := -1 { continue }
  196.        end;
  197.      CmdJoin:
  198.        begin
  199.          i := Pos(' ',Status);
  200.          Delete(Status,1,i); { status code }
  201.          i := Pos(' ',Status);
  202.          Delete(Status,1,i); { number of articles }
  203.          i := Pos(' ',Status);
  204.          try
  205.            fFirstArticle := StrToInt(Copy(Status,1,i-1))
  206.          except
  207.            fFirstArticle := 1
  208.          end;
  209.          Delete(Status,1,i); { last article }
  210.          i := Pos(' ',Status);
  211.          try
  212.            fLastArticle := StrToInt(Copy(Status,1,i-1))
  213.          except
  214.            fLastArticle := 1
  215.          end;
  216.          fArticles := nil;
  217.          if fLastArticle >= fFirstArticle then
  218.            SetLength(fArticles,fLastArticle-fFirstArticle+1); // allocate
  219.        {$IFDEF DEBUG}
  220.          if Assigned(StatusMemo) then
  221.            StatusMemo.Lines.Add(Space(Indent)+IntToStr(fFirstArticle)+' to '+IntToStr(fLastArticle))
  222.          else
  223.            if IsConsole then writeln(fFirstArticle,' to ',fLastArticle);
  224.        {$ENDIF}
  225.          Command := CmdDone
  226.        end;
  227.      CmdMess:
  228.        begin
  229.          if ArtNr < 0 then { remaining part of article }
  230.            fArticles[-ArtNr-fFirstArticle] := fArticles[-ArtNr-fFirstArticle] + Status
  231.          else
  232.          begin
  233.            i := Pos(#13,Status);
  234.            if i > 0 then
  235.            begin
  236.              Delete(Status,1,i);
  237.              while (Length(Status) > 0) and (Status[1] in [#10,#13]) do Delete(Status,1,1)
  238.            end;
  239.            fArticles[ArtNr-fFirstArticle] := Status
  240.          end;
  241.          if EOD then Command := CmdDone
  242.          else
  243.            ArtNr := -abs(ArtNr) { negative }
  244.        end;
  245.      CmdQuit: Command := CmdDone
  246.   end;
  247.   if Command <> CmdDone then SocketWrite(Sender, Socket)
  248. end {SocketRead};
  249.  
  250. procedure TBNNTP.SocketWrite(Sender: TObject; Socket: TCustomWinSocket);
  251. var
  252.   Send: String;
  253. begin
  254.   Send := '';
  255.   case Command of
  256.     CmdList: if ArtNr >= 0 then Send := 'LIST';
  257.     CmdJoin: Send := 'GROUP ' + Status;
  258.     CmdMess: if ArtNr > 0 then
  259.                Send := 'ARTICLE ' + IntToStr(ArtNr);
  260.     CmdQuit: Send := 'QUIT'
  261.   end;
  262. {$IFDEF DEBUG}
  263.   if Assigned(StatusMemo) then
  264.     StatusMemo.Lines.Add(Space(Indent)+'> '+Send)
  265.   else
  266.     if IsConsole then writeln('> '+Send);
  267. {$ENDIF}
  268.   Socket.SendText(Send + CRLF)
  269. end {SocketWrite};
  270.  
  271. procedure TBNNTP.Wait;
  272. begin
  273. {$IFDEF DEBUG}
  274.   Inc(Indent);
  275.   if Assigned(StatusMemo) then
  276.     StatusMemo.Lines.Add(Space(Indent)+'Waiting...')
  277.   else
  278.     if IsConsole then writeln('Waiting...');
  279.   Inc(Indent);
  280. {$ENDIF}
  281.   repeat
  282.     Application.ProcessMessages
  283.   until Command = CmdDone;
  284. {$IFDEF DEBUG}
  285.   Dec(Indent);
  286.   if Assigned(StatusMemo) then
  287.     StatusMemo.Lines.Add(Space(Indent)+'Done.')
  288.   else
  289.     if IsConsole then writeln('Done.');
  290.   Dec(Indent);
  291. {$ENDIF}
  292. end;
  293.  
  294. procedure TBNNTP.Connect;
  295. begin
  296.   Command := CmdStart;
  297.   _Socket.Active := False;
  298.   _Socket.Host := fNewsServer;
  299.   _Socket.Open;
  300.   Wait
  301. end {Connect};
  302.  
  303. procedure TBNNTP.Disconnect;
  304. begin
  305.   Command := CmdQuit;
  306.   SocketWrite(Self,WinSocket);
  307.   Wait
  308. end {Connect};
  309.  
  310. procedure TBNNTP.JoinNewsGroup(const NewsGroup: String);
  311. begin
  312.   Status := NewsGroup;
  313.   Command := CmdJoin;
  314.   SocketWrite(Self,WinSocket);
  315.   Wait
  316. end {JoinNewsGroup};
  317.  
  318. procedure TBNNTP.ReadArticle(ArticleNr: Integer);
  319. begin
  320.   ArtNr := ArticleNr;
  321.   Command := CmdMess;
  322.   SocketWrite(Self,WinSocket);
  323.   Wait
  324. end {ReadArticle};
  325.  
  326.  
  327. procedure Register;
  328. begin
  329.   RegisterComponents('Dr.Bob',[TBNNTP])
  330. end;
  331.  
  332. end.
  333.  
  334.